home *** CD-ROM | disk | FTP | other *** search
/ BBS in a Box 3 / BBS in a box - Trilogy III.iso / Files / Tele / Pete Johnson / Mehit 3.0.b15<source> Folder / mehitFile.p < prev    next >
Encoding:
Text File  |  1991-06-28  |  15.2 KB  |  584 lines  |  [TEXT/PJMM]
  1. unit mehitFile;
  2.  
  3. interface
  4.  
  5. uses
  6.     Globals, HelloTabby, Centerer;
  7.  
  8. var
  9.     CLPath, ULPath, SysopName: STR255;
  10.     NextLaunchDateRec: DateTimeRec;
  11.     MsgPath: STR255;
  12.     LowMsg, HiMsg, MSGTXTLength: longint;
  13.     SectionCount: integer;
  14.  
  15. procedure MakePath (FName: STR255; VRefNum: integer; var MyPath: STR255);
  16.  
  17. procedure ReadConfig;
  18.  
  19. procedure ReadMESSAGES;
  20.  
  21. procedure MakeTextFile (FileName: STR255);
  22.  
  23. procedure FrameDItem (dLog: DialogPtr; iNum: integer);
  24.  
  25. function ReadVersion: STR255;
  26.  
  27. function AtEOF (fRefNum: Integer): Boolean;
  28.  
  29. function Wr (FileRefNum: integer; TheMessage: string): OSErr;
  30.  
  31. function WrLn (FileRefNum: integer; TheMessage: string): OSErr;
  32.  
  33. function ReadLine (FileRefNum: integer; var TheMessage: string): OSErr;
  34.  
  35. function CopyFile (FromFile, ToFile: str255): OSErr;
  36.  
  37. function FileExists (Filename: str255): boolean;
  38.  
  39. implementation
  40.  
  41. {-----------------------------------------------------------------    }
  42.  
  43. procedure MakePath; {(FName: STR255; VRefNum: integer; var MyPath: STR255)}
  44.  
  45.     var
  46.         MyPB: CInfoPBRec;
  47.  
  48.     begin
  49.         MyPath := '';
  50.         MyPB.ioCompletion := nil;
  51.         MyPB.ioNamePtr := @FName;
  52.         MyPB.ioVRefNum := VRefNum;
  53.         MyPB.ioFDirIndex := 0;
  54.         MyPB.ioDirID := 0;
  55.         Err := PBGetCatInfo(@MyPB, false);
  56.         MyPB.ioFDirIndex := -1;
  57.         MyPB.ioDirID := MyPB.ioDRParID;
  58.         while PBGetCatInfo(@MyPB, false) = NoErr do
  59.             begin
  60.                 MyPath := concat(MyPB.ioNamePtr^, ':', MyPath);
  61.                 MyPB.ioDirID := MyPB.ioDRParID;
  62.                 MyPB.ioFDirIndex := -1;
  63.             end;        {    while PBGetCatInfo(@MyPB, false) = NoErr    }
  64.     end;
  65.  
  66. {-----------------------------------------------------------------    }
  67.  
  68. function AtEOF;
  69.  
  70.     var
  71.         currPos, eofPos: LongInt;
  72.  
  73.     begin
  74.         Err := GetFPos(fRefNum, currPos);
  75.         Err := GetEOF(fRefNum, eofPos);
  76.         AtEOF := currPos = eofPos
  77.     end;
  78.  
  79. { ------------------------------------------------------ }
  80.  
  81. function Wr;
  82.  
  83. {    Writes string (without length byte) to text file, returns error code    }
  84.  
  85.     var
  86.         TheLength: longint;
  87.  
  88.     begin
  89.         TheLength := length(TheMessage);
  90.         Wr := FSWrite(FileRefNum, TheLength, Pointer(ord(@TheMessage) + 1));
  91.     end;
  92.  
  93. {-----------------------------------------------------------------    }
  94.  
  95. function WrLn;
  96.  
  97. {    Writes string (without length byte) to text file, returns error code    }
  98.  
  99.     begin
  100.         TheMessage := concat(TheMessage, ENDLINE);
  101.         WrLn := Wr(FileRefNum, TheMessage);
  102.     end;
  103.  
  104. {-----------------------------------------------------------------    }
  105.  
  106. function ReadLine;
  107.  
  108.     var
  109.         myPB: ParamBlockRec;
  110.         myString: STR255;
  111.  
  112.     begin
  113.         myString := '';
  114.         myPB.ioCompletion := nil;
  115.         myPB.ioRefNum := FileRefNum;
  116.         myPB.ioBuffer := Pointer(@TheMessage[1]);
  117.         myPB.ioReqCount := 255;
  118.         myPB.ioPosMode := 3456; {ASCII 13*256+128}
  119.         myPB.ioPosOffset := 0; {ignored}
  120.         ReadLine := PBRead(@myPB, False);
  121.         TheMessage[0] := char(myPB.ioActCount);
  122.  
  123.     end;
  124.  
  125. {-----------------------------------------------------------------    }
  126.  
  127. procedure FrameDItem;
  128.  
  129.     var
  130.         iBox: Rect;
  131.         iType: integer;
  132.         iHandle: Handle;
  133.         oldPenState: PenState;
  134.  
  135.     begin
  136.         GetPenState(oldPenState);
  137.         GetDItem(dLog, iNum, iType, iHandle, iBox);
  138.         InsetRect(iBox, -4, -4);
  139.         PenSize(3, 3);
  140.         FrameRoundRect(iBox, 16, 16);
  141.         SetPenState(oldPenState)
  142.     end;
  143.  
  144. {-----------------------------------------------------------------    }
  145.  
  146. procedure MakeTextFile;
  147.  
  148. { Procedure sets up QUED-compatible text  file                                }
  149.  
  150.     var
  151.         fndrInfo: FInfo;
  152.  
  153.     begin
  154.         Err := GetFInfo(FileName, vRefNum, fndrInfo);
  155.         if Err = noErr then
  156.             begin
  157.                 fndrInfo.fdType := 'TEXT';
  158.                 fndrInfo.fdCreator := DefaultsPtr^.TextType;
  159.                 Err := SetFInfo(FileName, vRefNum, fndrInfo);
  160.             end
  161.         else
  162.             Err := Create(FileName, vRefNum, 'QED1', 'TEXT');
  163.     end;
  164.  
  165. {-----------------------------------------------------------------    }
  166.  
  167. procedure MissingFile (WhichOne: STR255);
  168.  
  169.     var
  170.         theDialog: DialogPtr;
  171.         DlogItem: integer;
  172.  
  173.     begin
  174.         theDialog := GetNewDialog(1009, nil, Pointer(-1));
  175.         SetPort(theDialog);
  176.         CenterDLOG(theDialog);
  177.         ShowWindow(theDialog);
  178.         paramtext(WhichOne, '', '', '');
  179.         FrameDItem(theDialog, OK);
  180.         ModalDialog(nil, DlogItem);
  181.         repeat
  182.         until DlogItem = 1;
  183.         DisposDialog(theDialog);
  184.         exitToShell
  185.     end;
  186.  
  187. {-----------------------------------------------------------------    }
  188.  
  189. procedure ReadMESSAGES;
  190.  
  191. { Procedure reads the MESSAGES file                                }
  192.  
  193.     var
  194.         MSCount: integer;
  195.         MsgByte: signedByte;
  196.         MsgString: STR255;
  197.         CharsToSend: longint;
  198.         OneEntry: SectionPtr;
  199.         Counter: byte;
  200.         TestFile: STR255;
  201.         TestRef, MSGRefNum: integer;
  202.  
  203.     begin
  204.         Counter := 0;
  205.         Err := FSOpen(MESSAGESPath, VRefNum, MSGRefNum);
  206.  
  207.         if Err = NoErr then
  208.             begin
  209.                 OneEntry := SectionPtr(NewPtr(SizeOf(Section)));
  210.                 CharsToSend := 50;
  211.                 Err := FSRead(MSGRefNum, CharsToSend, @MsgPath);
  212.                 if MsgPath <> '' then
  213.                     MsgPath := concat(MsgPath, ':');
  214.  
  215.                 CharsToSend := 4;
  216.                 Err := SetFPos(MSGRefNum, fsFromStart, 50);
  217.                 Err := FSRead(MSGRefNum, CharsToSend, @LowMsg);
  218.                 Err := FSRead(MSGRefNum, CharsToSend, @HiMsg);
  219.                 Err := FSRead(MSGRefNum, CharsToSend, @MSGTXTLength);
  220.  
  221.                 if Err = NoErr then
  222.                     for MSCount := 1 to 255 do
  223.                         begin
  224.                             Err := SetFPos(MSGRefNum, fsFromStart, (62 + (MSCount - 1) * 36));
  225.                             CharsToSend := 255;
  226.                             Err := FSRead(MSGRefNum, CharsToSend, Ptr(OneEntry));
  227.                             if OneEntry^.Name <> '' then
  228.                                 begin
  229.                                     Counter := succ(Counter);
  230.                                     Sections[Counter] := SectionHandle(NewHandle(SizeOf(Section)));
  231.                                     MoveHHI(Handle(Sections[Counter]));
  232.                                     HLock(Handle(Sections[Counter]));
  233.                                     Sections[Counter]^^.Name := OneEntry^.Name;
  234.                                     Sections[Counter]^^.Number := MSCount;
  235.                                 end;
  236.                         end;
  237.                 Err := FSClose(MSGRefNum);
  238.                 SectionCount := Counter;
  239.                 DisposPtr(Ptr(OneEntry));
  240.  
  241.                 TestFile := concat(MsgPath, 'MSGHDR');
  242.                 Err := FSOpen(TestFile, VRefNum, TestRef);
  243.                 if Err <> NoErr then
  244.                     MissingFile('msghdr')
  245.                 else
  246.                     begin
  247.                         Err := FSClose(TestRef);
  248.                         TestFile := concat(MsgPath, 'MSGTXT');
  249.                         Err := FSOpen(TestFile, VRefNum, TestRef);
  250.                         if Err <> NoErr then
  251.                             MissingFile('msgtxt')
  252.                         else
  253.                             Err := FSClose(TestRef);
  254.                     end;
  255.             end
  256.         else
  257.     {    Error opening MESSAGES    }
  258.             MissingFile('messages');
  259.     end;
  260.  
  261. { ------------------------------------------------------ }
  262.  
  263. procedure ReadConfig;
  264.  
  265. {    Reads Config file and returns Path:CallerLog, Path:UserLog, Path:MESSAGES, SysopName    (all caps)    and    }
  266. {    NextLaunchDateRec.                        }
  267.  
  268.     var
  269.         AString: string;
  270.         ALongInt: LongInt;
  271.         ConfigRefNum: integer;
  272.         FileEnd, CharsToSend, NextLaunchTime: longint;
  273.         ConfigErr: OSErr;
  274.         VolName: STR255;
  275.         ConfigErrorFlag: boolean;
  276.         MF: signedbyte;
  277.  
  278.     begin
  279.  
  280.         ConfigErrorFlag := false;
  281.  
  282.         ConfigErr := GetVol(@VolName, VRefNum);        { Get volume ref # for default volume }
  283.         if (ConfigErr <> NoErr) then
  284.             ConfigErrorFlag := true;
  285.         MESSAGESPath := '';
  286.         ULPath := '';
  287.         CLPath := '';
  288.         SysopName := 'SYSTEM OPERATOR';
  289.         ConfigErr := FSOpen(concat(gDefaultpath, 'Config'), VRefNum, ConfigRefNum);
  290.         if (ConfigErr = NoErr) then
  291.             begin
  292.                 ConfigErr := GetEOF(ConfigRefNum, FileEnd);
  293.                 if (ConfigErr = NoErr) then
  294.                     begin
  295.                         if (FileEnd > 317) then        {    Is file longer than our deepest SetFPos (it should be 349)?    }
  296.                             begin
  297.                                 CharsToSend := 41;
  298.                                 ConfigErr := SetFPos(ConfigRefNum, fsFromStart, 57);
  299.                                 if (ConfigErr <> NoErr) then
  300.                                     ConfigErrorFlag := true;
  301.                                 ConfigErr := FSRead(ConfigRefNum, CharsToSend, @AString);
  302.                                 if (ConfigErr <> NoErr) then
  303.                                     ConfigErrorFlag := true;
  304.                                 if length(AString) > 0 then
  305.                                     ULPath := AString;
  306.                                 ULPath := concat(ULPath, ':UserLog');
  307.  
  308.                                 if (ConfigErrorFlag = false) then
  309.                                     begin
  310.                                         CharsToSend := 41;
  311.                                         ConfigErr := SetFPos(ConfigRefNum, fsFromStart, 98);
  312.                                         if (ConfigErr <> NoErr) then
  313.                                             ConfigErrorFlag := true;
  314.                                         ConfigErr := FSRead(ConfigRefNum, CharsToSend, @AString);
  315.                                         if (ConfigErr <> NoErr) then
  316.                                             ConfigErrorFlag := true;
  317.                                         if length(AString) > 0 then
  318.                                             CLPath := AString;
  319.                                         CLPath := concat(CLPath, ':CallerLog');
  320.                                     end;
  321.  
  322.                                 if (ConfigErrorFlag = false) then
  323.                                     begin
  324.                                         CharsToSend := 80;
  325.                                         ConfigErr := SetFPos(ConfigRefNum, fsFromStart, 139);
  326.                                         if (ConfigErr <> NoErr) then
  327.                                             ConfigErrorFlag := true;
  328.                                         ConfigErr := FSRead(ConfigRefNum, CharsToSend, @AString);
  329.                                         if (ConfigErr <> NoErr) then
  330.                                             ConfigErrorFlag := true;
  331.                                         if length(AString) > 0 then
  332.                                             MESSAGESPath := AString;
  333.                                         MESSAGESPath := concat(MESSAGESPath, ':MESSAGES');
  334.                                     end;
  335.  
  336.                                 if (ConfigErrorFlag = false) then
  337.                                     begin
  338.                                         CharsToSend := 31;
  339.                                         ConfigErr := SetFPos(ConfigRefNum, fsFromStart, 317);
  340.                                         if (ConfigErr <> NoErr) then
  341.                                             ConfigErrorFlag := true;
  342.                                         ConfigErr := FSRead(ConfigRefNum, CharsToSend, @AString);
  343.                                         if (ConfigErr <> NoErr) then
  344.                                             ConfigErrorFlag := true;
  345.                                         if length(AString) > 0 then
  346.                                             SysopName := AString
  347.                                     end;
  348.  
  349.                                 if (ConfigErrorFlag = false) then
  350.                                     begin
  351.                                         CharsToSend := 4;
  352.                                         ConfigErr := SetFPos(ConfigRefNum, fsFromStart, 308);
  353.                                         if (ConfigErr <> NoErr) then
  354.                                             ConfigErrorFlag := true;
  355.                                         ConfigErr := FSRead(ConfigRefNum, CharsToSend, @ALongInt);
  356.                                         if (ConfigErr <> NoErr) then
  357.                                             ConfigErrorFlag := true;
  358.                                         Secs2Date(ALongInt, NextLaunchDateRec);
  359.                                     end;
  360.  
  361.                                 if (ConfigErrorFlag = false) then
  362.                                     begin
  363.                                         CharsToSend := 1;
  364.                                         ConfigErr := SetFPos(ConfigRefNum, fsFromStart, 316);
  365.                                         if (ConfigErr <> NoErr) then
  366.                                             ConfigErrorFlag := true;
  367.                                         ConfigErr := FSRead(ConfigRefNum, CharsToSend, @MF);
  368.                                         if (ConfigErr <> NoErr) then
  369.                                             ConfigErrorFlag := true;
  370.                                         if MF = 0 then
  371.                                             MultiFinder := false    {    operating under MultiFinder?    }
  372.                                         else
  373.                                             MultiFinder := true;
  374.                                         ConfigErr := FSClose(ConfigRefNum);
  375.                                     end
  376.  
  377.                             end    {    if FileEnd > 317        }
  378.                         else
  379.                             ConfigErrorFlag := true;
  380.                     end    {    Error on get eof of Config    }
  381.                 else
  382.                     ConfigErrorFlag := true;
  383.             end    {    Error on open Config    }
  384.         else
  385.             ConfigErrorFlag := true;
  386.         if ConfigErrorFlag then
  387.             begin
  388.                 ConfigErr := FSClose(ConfigRefNum);
  389.                 MissingFile('config')
  390.             end
  391.     end;
  392.  
  393. { ------------------------------------------------------ }
  394.  
  395. function ReadVersion;
  396.  
  397.     type
  398.         NumVersion = packed record
  399.                 case INTEGER of
  400.                     0: (
  401.                             majorRev: SignedByte;        {1st part of version number in BCD}
  402.                             MinorAndBugFixRev: SignedByte;    {1st and 2nd nibbles in BCD}
  403.                             stage: Byte;                {stage code: dev, alpha, beta, final}
  404.                             nonRelRev: SignedByte
  405.                     ); {revision level of non-released version}
  406.  
  407.                     1: (
  408.                             version: LONGINT
  409.                     );     {to use all 4 fields at one time}
  410.             end;
  411.  
  412.  
  413.         VersRec = record
  414.                 numericVersion: NumVersion;        {encoded version number}
  415.                 countryCode: INTEGER;                {country code from intl utilities}
  416.                 shortVersion: Str255;                {version number string - worst case}
  417.                 reserved: Str255;                {longMessage string packed after shortVersion    }
  418.             end;
  419.  
  420.         VersRecPtr = ^VersRec;
  421.         VersRecHndl = ^VersRecPtr;
  422.  
  423.     const
  424.         dev = $20;
  425.         alpha = $40;
  426.         beta = $60;
  427.         rel = $80;
  428.  
  429.     var
  430.         AString, TheVers: STR255;
  431.         versionHndl: VersRecHndl;
  432.         MinorRev, BugFixRev: integer;
  433.         Final: boolean;
  434.  
  435.     begin
  436.         Final := false;
  437.         versionHndl := VersRecHndl(NewHandle(sizeOf(VersRec)));
  438.         versionHndl := VersRecHndl(GetResource('vers', 1));
  439.  
  440.         with versionHndl^^.numericVersion do
  441.             begin
  442.                 if (majorRev > 0) then
  443.                     begin
  444.                         if majorRev > $0F then
  445.                             TheVers := StringOf(majorRev mod $0F : 1)
  446.                         else
  447.                             TheVers := '';
  448.                         majorRev := BitAnd(majorRev, $0F);
  449.                         if (majorRev > 0) then
  450.                             TheVers := concat(TheVers, StringOf(majorRev : 1));
  451.                         TheVers := concat(TheVers, TheVers);
  452.                     end        {    if (majorRev > 0)    }
  453.                 else
  454.                     TheVers := '0';
  455.             end;    {with}
  456.  
  457.         NumToString(versionHndl^^.numericVersion.majorRev, TheVers);
  458.         MinorRev := versionHndl^^.numericVersion.MinorAndBugFixRev mod 128;
  459.         BugFixRev := versionHndl^^.numericVersion.MinorAndBugFixRev div 128;
  460.         if (MinorRev > 0) then
  461.             begin
  462.                 if MinorRev > $0F then
  463.                     AString := StringOf(MinorRev mod $0F : 1)
  464.                 else
  465.                     AString := '';
  466.                 MinorRev := BitAnd(MinorRev, $0F);
  467.                 if (MinorRev > 0) then
  468.                     AString := concat(AString, StringOf(MinorRev : 1));
  469.                 TheVers := concat(TheVers, '.', AString);
  470.             end
  471.         else
  472.             TheVers := concat(TheVers, '.0');
  473.         if (BugFixRev > 0) then
  474.             begin
  475.                 if BugFixRev > $0F then
  476.                     AString := StringOf(BugFixRev mod $0F : 1)
  477.                 else
  478.                     AString := '';
  479.                 MinorRev := BitAnd(BugFixRev, $0F);
  480.                 if (BugFixRev > 0) then
  481.                     AString := concat(AString, StringOf(BugFixRev : 1));
  482.                 TheVers := concat(TheVers, '.', AString);
  483.             end;
  484.         if (versionHndl^^.numericVersion.stage > 0) then
  485.             begin
  486.                 case versionHndl^^.numericVersion.stage of
  487.                     dev: 
  488.                         TheVers := concat(TheVers, 'd');
  489.                     alpha: 
  490.                         TheVers := concat(TheVers, 'a');
  491.                     beta: 
  492.                         TheVers := concat(TheVers, 'ß');
  493.                     rel: 
  494.                         Final := true;
  495.                     otherwise
  496.                         ;
  497.                 end;    {        Case statement    }
  498.             end;        {    if (versionHndl^^.numericVersion.stage > 0)    }
  499.         if (versionHndl^^.numericVersion.stage > 0) & not Final then
  500.             begin
  501.                 if versionHndl^^.numericVersion.nonRelRev > 9 then
  502.                     begin
  503.                         TheVers := concat(TheVers, stringOf(versionHndl^^.numericVersion.nonRelRev div 16 : 1));
  504.                         versionHndl^^.numericVersion.nonRelRev := versionHndl^^.numericVersion.nonRelRev mod 16;
  505.                     end;
  506.                 TheVers := concat(TheVers, StringOf(versionHndl^^.numericVersion.nonRelRev : 1));
  507.             end;
  508.  
  509.         ReadVersion := TheVers;
  510.  
  511.         DisposHandle(Handle(versionHndl));
  512.     end;
  513.  
  514. { ------------------------------------------------------ }
  515.  
  516. function FileExists;{(Filename: str255): boolean}
  517.  
  518.     var
  519.         fRef: integer;
  520.  
  521.     begin
  522.         Err := FSOpen(Filename, vRefNum, fRef);
  523.         if Err = NoErr then
  524.             begin
  525.                 Err := FSClose(fRef);
  526.                 FileExists := true
  527.             end
  528.         else
  529.             FileExists := false
  530.     end;
  531.  
  532. { ------------------------------------------------------ }
  533.  
  534. function CopyFile;{(FromFile, ToFile: str255): OSErr}
  535.  
  536. {    Copies all data from one file to another in CopyChunk-size reads & writes.    }
  537. {    Sets destination file creator and type to same as origin file. Does not    }
  538. {    delete destination file, just overwrites its EOF mark and refills it with    }
  539. {    different data. If there's a problem, returns non-zero error code.        }
  540.  
  541.     const
  542.         CopyChunk = 1024;
  543.  
  544.     var
  545.         theVol, fromRef, toRef: integer;
  546.         theDir, fileLength: longint;
  547.         fndrInfo: FInfo;
  548.         myHandle: handle;
  549.         howMuch: longint;
  550.  
  551.     begin
  552.         howMuch := CopyChunk;
  553.         Err := HGetFInfo(theVol, theDir, FromFile, fndrInfo);
  554.         if Err = NoErr then
  555.             Err := HOpen(theVol, theDir, FromFile, fsRdPerm, fromRef);
  556.         if Err = NoErr then
  557.             Err := GetEOF(fromRef, fileLength);
  558.         if Err = NoErr then
  559.             Err := HCreate(theVol, theDir, ToFile, fndrInfo.fdCreator, fndrInfo.fdType);
  560.         if Err = NoErr then
  561.             Err := HOpen(theVol, theDir, ToFile, fsRdWrPerm, toRef);
  562.         if Err = NoErr then
  563.             Err := SetEOF(toRef, fileLength);        {    same as input length    }
  564.         if Err = NoErr then
  565.             begin
  566.                 myHandle := NewHandle(CopyChunk);
  567.                 MoveHHi(myHandle);
  568.                 HLock(myHandle);
  569.                 while (howMuch = CopyChunk) & (not AtEOF(fromRef)) & (Err = NoErr) do
  570.                     begin
  571.                         Err := FSRead(fromRef, howMuch, myHandle^);
  572.                         Err := FSWrite(toRef, howMuch, myHandle^)
  573.                     end;
  574.                 HUnLock(myHandle);
  575.                 DisposHandle(myHandle);
  576.                 myHandle^ := nil;
  577.                 Err := NoErr
  578.             end;
  579.         CopyFile := Err;
  580.         Err := FSClose(fromRef);
  581.         Err := FSClose(toRef)
  582.     end;
  583.  
  584. end.    {    Unit    }